Option Explicit

Sub ConvertMergedCellsToCenterAcross()

Dim ws As Worksheet
Dim selectedWsNames() As String
Dim c As Range
Dim mergedRange As Range
Dim i As Long


'Store the currently selected worksheets
ReDim selectedSheetNames(1 To ActiveWindow.SelectedSheets.Count)
i = 0
For Each ws In ActiveWindow.SelectedSheets
    i = i + 1
    selectedSheetNames(i) = ws.Name
Next ws

'Turn Off Screenupdating
Application.ScreenUpdating = False

'Continue if errors
On Error Resume Next

'Loop through the selected sheets
For Each ws In ActiveWindow.SelectedSheets
    ws.Select
    
    'Don't try to change chart sheets
    If TypeName(ws) = "Worksheet" Then

        'Loop through all cells in Used range
        For Each c In ws.UsedRange
        
            'If merged and single row
            If c.MergeCells = True And c.MergeArea.Rows.Count = 1 Then
        
                'Set variable for the merged range
                Set mergedRange = c.MergeArea
        
                'Unmerge the cell and apply Centre Across Selection
                mergedRange.UnMerge
                mergedRange.HorizontalAlignment = xlCenterAcrossSelection
        
            End If
        
        Next

    End If

Next ws

'Reselect the sheets
Worksheets(selectedSheetNames).Select

'Turn error checking back on
On Error GoTo 0

'Turn In Screenupdating
Application.ScreenUpdating = True


End Sub
